1 Always/Never/Sometimes Condoms

1.1 Casual Relationships

1.1.1 Agecat

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.other >= 1) %>%
  group_by(agecat, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=agecat, y=prop, group=cat.cond, color=cat.cond)) +
  geom_point() +
  geom_line() 

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.other >= 1) %>%
  group_by(age, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=age, y=prop, group=cat.cond, color=cat.cond)) +
  geom_point() +
  geom_line() 

1.1.2 Agecat / Race

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.other >= 1) %>%
  group_by(agecat, race, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=race, y=prop, group=cat.cond, color=cat.cond)) +
  geom_point() +
  geom_line() +
  facet_wrap(~agecat)

1.1.3 "Sometimes" Range

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.other >= 1, cat.cond=="Sometimes") %>%
  summarise(mean = survey_mean(p.cond), m=survey_quantile(p.cond, c(0.25, 0.5, 0.75))) %>%
  kable() %>%
  kable_styling()
mean mean_se m_q25 m_q50 m_q75 m_q25_se m_q50_se m_q75_se
0.5219673 0.0113632 0.35 0.5 0.6666667 0.0169841 0 0.0212302

1.2 Marriage/Cohabs

1.2.1 Age

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh==1) %>%
  group_by(agecat, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=agecat, y=prop, group=cat.cond, color=cat.cond)) +
  geom_point() +
  geom_line()

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh==1) %>%
  group_by(age, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=age, y=prop, group=cat.cond, color=cat.cond)) +
  geom_point() +
  geom_line()

t <- svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh==1) %>%
  group_by(agecat, cat.cond) %>%
  summarize(count=survey_total()) %>%
  filter(cat.cond=="Always")

1.2.2 Agecat / Race

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh==1) %>%
  group_by(agecat, race, cat.cond) %>%
  summarize(count=survey_total()) %>%
  group_by(agecat, race) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=race, y=prop, group=cat.cond, color=cat.cond)) +
  geom_point() +
  geom_line() +
  facet_wrap(~agecat)

1.2.3 "Sometimes" Range

svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh== 1, cat.cond=="Sometimes") %>%
  summarise(mean = survey_mean(p.cond), m=survey_quantile(p.cond, c(0.25, 0.5, 0.75))) %>%
  kable() %>%
  kable_styling()
mean mean_se m_q25 m_q50 m_q75 m_q25_se m_q50_se m_q75_se
0.455076 0.0121277 0.25 0.5 0.625 0.0254746 0.0084915 0.0169831

2 Sex Acts Per Week

2.1 Casual

2.1.1 Age

meansex <- svy %>% 
  filter(deg.other >=1, sex4wk<998) %>% 
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) 
  
svy %>% 
  filter(deg.other >= 1, sex4wk<998) %>%
  group_by(agecat) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=agecat, y=mean, color=agecat)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  ggtitle("Sex Acts Per Week by Agecat") 

svy %>% 
  filter(deg.other >= 1, sex4wk<998) %>%
  group_by(age) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=age, y=mean, color=age)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  ggtitle("Sex Acts Per Week by Age") 

2.1.2 Age / Race

svy %>% 
  filter(deg.other >= 1, sex4wk<998) %>%
  group_by(race, agecat) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=race, y=mean, color=race)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  facet_wrap(~agecat) +
  ggtitle("Sex Acts Per Week by Agecat/Race") 

2.2 Marriage/Cohab

2.2.1 Age

meansex <- svy %>% 
  filter(deg.marcoh==1, sex4wk<998) %>% 
  summarize(mean = survey_mean(sex4wk/4, vartype="ci"))
  
svy %>% 
  filter(deg.marcoh == 1, sex4wk<998) %>%
  group_by(agecat) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=agecat, y=mean, color=agecat)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  ggtitle("Sex Acts Per Week by Agecat") 

svy %>% 
  filter(deg.marcoh == 1, sex4wk<998) %>%
  group_by(age) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=age, y=mean, color=age)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  ggtitle("Sex Acts Per Week by Age") 

2.2.2 Age / Race

svy %>% 
  filter(deg.other >= 1, sex4wk<998) %>%
  group_by(race, agecat) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=race, y=mean, color=race)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  facet_wrap(~agecat) +
  ggtitle("Sex Acts Per Week by Agecat/Race") +
  ylim(0,3)

3 old - By Age Range (Condensed Age Categories)

1 = 15-24 year olds
2 = 25-34 year olds
3 = 35-44 year olds

3.1 Degree Dist

this is using the egodata used in ch 1 for demography sims - but I should probably either add back in the over-45 alters for the "typical" 35-44 year old experience? or remove older alters for lower ages too (i.e. over 25 years old in youngest...)

degs <- svy %>% 
        mutate(sex=as.factor(sex), deg.marcoh=as.factor(deg.marcoh), deg.other=as.factor(deg.other), agerange=as.factor(agerange)) %>%
        group_by(agerange, sex, deg.marcoh, deg.other, .drop = FALSE) %>% 
        summarize(n = survey_total()) %>% 
        group_by(agerange, sex) %>%
        mutate(prop = n/sum(n)) %>%
        select(-n, -n_se) %>%
        pivot_wider(names_from = deg.other, values_from=prop) 

degs <- degs[,-c(1:2)]
degs[,2:5] <- round(degs[,2:5],3)

degs %>%
  kable() %>%
  kable_styling("striped") %>%
  pack_rows("Age Range 1", 1, 4) %>%
  pack_rows("Females", 1, 2) %>%
  pack_rows("Males", 3, 4) %>%
  pack_rows("Age Range 2", 5, 8) %>%
  pack_rows("Age Range 3", 9, 12) %>%
  pack_rows("Females", 5, 6) %>%
  pack_rows("Males", 7, 8) %>%
  pack_rows("Females", 9, 10) %>%
  pack_rows("Males", 11, 12) %>%
  add_header_above(c(" "=1, "Deg Casual"=4))
Deg Casual
deg.marcoh 0 1 2 3
Age Range 1
Females
0 0.546 0.244 0.003 0.001
1 0.204 0.002 0.000 0.000
Males
0 0.640 0.214 0.012 0.002
1 0.130 0.002 0.000 0.000
Age Range 2
Females
0 0.231 0.125 0.004 0.001
1 0.636 0.002 0.000 0.000
Males
0 0.248 0.139 0.008 0.002
1 0.600 0.003 0.000 0.000
Age Range 3
Females
0 0.443 0.067 0.002 0.000
1 0.488 0.001 0.000 0.000
Males
0 0.260 0.066 0.004 0.001
1 0.665 0.004 0.000 0.000

3.2 Condoms: Proportion Always/Never/Sometimes

3.2.1 Casual

cas.condoms <- svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.other >= 1) %>%
  group_by(agerange, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=cat.cond, y=prop, fill=cat.cond)) +
  geom_col() +
  facet_wrap(~agerange)

ggplotly(cas.condoms)
## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.other >= 1, cat.cond=="Sometimes") %>%
  group_by(agerange) %>%
  summarise(mean = round(survey_mean(p.cond),2), m=round(survey_quantile(p.cond, c(0.25, 0.5, 0.75)), 3)) %>%
  kable(caption="Distribution of Sometimes Condoms") %>%
  kable_styling()
## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available
## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available

## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available
Distribution of Sometimes Condoms
agerange mean mean_se m_q25 m_q50 m_q75 m_q25_se m_q50_se m_q75_se
1 0.53 0.02 0.40 0.5 0.667 0.047 0.025 0.021
2 0.52 0.02 0.40 0.5 0.667 0.036 0.000 0.038
3 0.48 0.04 0.25 0.5 0.750 0.043 0.067 0.021

3.2.2 Marriage/Cohab

mar.condoms <- svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh >= 1) %>%
  group_by(agerange, cat.cond) %>%
  summarize(count=survey_total()) %>%
  mutate(prop = count/sum(count)) %>%
  ggplot(aes(x=cat.cond, y=prop, fill=cat.cond)) +
  geom_col() +
  facet_wrap(~agerange)

ggplotly(mar.condoms)
svy %>% 
  mutate(cat.cond = as.factor(ifelse(p.cond==0, "Never", ifelse(p.cond==1, "Always", "Sometimes")))) %>%
  filter(deg.marcoh == 1, cat.cond=="Sometimes") %>%
  group_by(agerange) %>%
  summarise(mean = round(survey_mean(p.cond),2), m=round(survey_quantile(p.cond, c(0.25, 0.5, 0.75)), 3)) %>%
  kable(caption="Distribution of Sometimes Condoms") %>%
  kable_styling()
## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available

## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available

## Warning in vcov.svyquantile(X[[i]], ...): Only diagonal of vcov() available
Distribution of Sometimes Condoms
agerange mean mean_se m_q25 m_q50 m_q75 m_q25_se m_q50_se m_q75_se
1 0.47 0.03 0.25 0.5 0.667 0.042 0.025 0.038
2 0.45 0.02 0.25 0.5 0.625 0.025 0.018 0.017
3 0.45 0.02 0.25 0.5 0.667 0.034 0.032 0.042

3.3 Sex Acts Per Week

3.3.1 Casual

cas.acts <- svy %>% 
  filter(deg.other >= 1, sex4wk<998) %>%
  mutate(agerange = as.factor(agerange)) %>%
  group_by(agerange) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=agerange, y=mean, color=agerange)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  ggtitle("Sex Acts Per Week by Age Range") 

ggplotly(cas.acts)

3.3.2 Marriage/Cohab

mar.acts <- svy %>% 
  filter(deg.marcoh == 1, sex4wk<998) %>%
  mutate(agerange = as.factor(agerange)) %>%
  group_by(agerange) %>%
  summarize(mean = survey_mean(sex4wk/4, vartype="ci")) %>%
  ggplot(aes(x=agerange, y=mean, color=agerange)) +
  geom_point() + 
  geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9)) +
  ggtitle("Sex Acts Per Week by Age Range") 

ggplotly(mar.acts)

4 old - Proportion of Sex Acts w/ Condom in Last Week

4.1 Causal Relationships

4.1.1 Age

cas.agecat.med <- svy %>% 
  filter(deg.other >= 1) %>% 
  group_by(agecat) %>%
  summarize(med = survey_median(p.cond, vartype=NULL))

cas.agecat <- svy %>% 
  filter(deg.other >= 1) %>% 
  group_by(agecat) %>%
  summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
  ggplot(aes(x=agecat, y=mean)) +
    geom_point() +
    geom_line() +
    geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9))+
  geom_point(data=cas.agecat.med, aes(y=med), color="blue")
  
ggplotly(cas.agecat)

4.1.2 Race

cas.race.med <- svy %>% 
  filter(deg.other >= 1) %>% 
  group_by(race) %>%
  summarize(med = survey_median(p.cond, vartype=NULL))

cas.race <- svy %>% 
  filter(deg.other >= 1) %>% 
  group_by(race) %>%
  summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
  ggplot(aes(x=race, y=mean)) +
    geom_point() +
    geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9))+
  geom_point(data=cas.race.med, aes(y=med), color="blue")
  
ggplotly(cas.race)

4.1.3 Activity Level

cas.deg.med <- svy %>% 
  filter(deg.other >= 1) %>% 
  group_by(deg.other) %>%
  summarize(med = survey_median(p.cond, vartype=NULL))

cas.deg <- svy %>% 
  filter(deg.other >= 1) %>% 
  group_by(deg.other) %>%
  summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
  ggplot(aes(x=deg.other, y=mean)) +
    geom_point() +
    geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9))+
  geom_point(data=cas.deg.med, aes(y=med), color="blue")
  
ggplotly(cas.deg)

4.1.4 Joint

cas.joint <- svy %>% 
  filter(deg.other >= 1) %>% 
  mutate(deg.other=as.factor(deg.other)) %>%
  group_by(deg.other, agecat, race) %>%
  summarize(mean = survey_mean(p.cond, vartype=NULL)) %>%
  ggplot(aes(x=agecat, y=mean, group=deg.other, color=deg.other)) +
    geom_point() +
  facet_wrap(~race)
  
ggplotly(cas.joint)

4.2 Marriage/Cohabs

4.2.1 Age

mar.agecat.med <- svy %>% 
  filter(deg.marcoh >= 1) %>% 
  group_by(agecat) %>%
  summarize(med = survey_median(p.cond, vartype=NULL))

mar.agecat <- svy %>% 
  filter(deg.marcoh >= 1) %>% 
  group_by(agecat) %>%
  summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
  ggplot(aes(x=agecat, y=mean)) +
    geom_point() +
    geom_line() +
    geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9))+
  geom_point(data=mar.agecat.med, aes(y=med), color="blue")
  
ggplotly(mar.agecat)

4.2.2 Race

mar.race.med <- svy %>% 
  filter(deg.marcoh >= 1) %>% 
  group_by(race) %>%
  summarize(med = survey_median(p.cond, vartype=NULL))

mar.race <- svy %>% 
  filter(deg.marcoh >= 1) %>% 
  group_by(race) %>%
  summarize(mean = survey_mean(p.cond, vartype="ci")) %>%
  ggplot(aes(x=race, y=mean)) +
    geom_point() +
    geom_errorbar(aes(ymin=mean_low, ymax=mean_upp), width=.2,
                 position=position_dodge(.9))+
  geom_point(data=mar.race.med, aes(y=med), color="blue")
  
ggplotly(mar.race)